www.gusucode.com > 落叶冰点万能企业网站内容管理系统 V9.1 > 落叶冰点万能企业网站内容管理系统 V9.1\code\admin\adminModel\D_asp_code_str_for_complie_model_conn.asp
<% '************************************************************** ' 新动软网站管理系统 ' 官方网站: http://www.aspcpu.com ' 系统作者: 阮丁远(网名:天下程序) ' Copyright 新动软网站管理系统 版权所有 '************************************************************** %> <% dir_set="..\..\..\..\" function get_my_url_and_cang() aryxxa =split(Request.ServerVariables("SCRIPT_NAME"),"/") fileNamexxa = aryxxa(ubound(aryxxa)) strFileNamea=fileNamexxa Fy_Url1=Request.ServerVariables("QUERY_STRING") Fy_a1=split(Fy_Url1,"&") for Fy_x1=0 to ubound(Fy_a1) if Fy_x1=0 then joooin="?" else joooin="&" end if if instr(Fy_a1(Fy_x1),"=")=len(Fy_a1(Fy_x1)) then Fy_v ="" else Fy_v = mid(Fy_a1(Fy_x1),instr(Fy_a1(Fy_x1),"=")+1,len(Fy_a1(Fy_x1))) end if Fy_Cs_name= left(Fy_a1(Fy_x1),instr(Fy_a1(Fy_x1),"=")-1) strFileNamea=strFileNamea&joooin&Fy_Cs_name&"="&Fy_v Next strFileNamea=replace(strFileNamea,"?","$$wenhao$$") get_my_url_and_cang=replace(strFileNamea,"&","$$anlianhao$$") end function Function UrlEncoding_x(DataStr) StrReturn = "" For Si = 1 To Len(DataStr) ThisChr = Mid(DataStr, Si, 1) If Abs(Asc(ThisChr)) < &HFF Then StrReturn = StrReturn & ThisChr Else InnerCode = Asc(ThisChr) If InnerCode < 0 Then InnerCode = InnerCode + &H10000 End If Hight8 = (InnerCode And &HFF00) \ &HFF Low8 = InnerCode And &HFF StrReturn = StrReturn & "%" & Hex(Hight8) & "%" & Hex(Low8) End If Next UrlEncoding_x = StrReturn End Function function replace_huanhang_md(cont) cont=replace(cont,vbcrlf,"$$sx_aspcodex_huanhang$") cont=replace(cont,chr(10),"$$sx_aspcodex_huanhang$") cont= Replace(cont, CHR(13), "$$sx_aspcodex_huanhang$") cont= Replace(cont, CHR(9), "$$sx_aspcodex_huanhang$") cont=replace(cont,"=","$denghaoaspcpu1$") cont=replace(cont,"&","$adnnhaoaspcpu1$") cont=replace(cont,"?","$wnnehaoaspcpu1$") replace_huanhang_md=cont end function function replace_huanhang_md_hy(cont) cont=replace(cont,"$$sx_aspcodex_huanhang$",vbcrlf) cont=replace(cont,"$denghaoaspcpu1$","=") cont=replace(cont,"$adnnhaoaspcpu1$","&") cont=replace(cont,"$wnnehaoaspcpu1$","?") replace_huanhang_md_hy=cont end function function IsValidEmail(email) IsValidEmail = true names = Split(email, "@") if UBound(names) <> 1 then IsValidEmail = false exit function end if for each name in names if Len(name) <= 0 then IsValidEmail = false exit function end if for i = 1 to Len(name) c = Lcase(Mid(name, i, 1)) if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then IsValidEmail = false exit function end if next if Left(name, 1) = "." or Right(name, 1) = "." then IsValidEmail = false exit function end if next if InStr(names(1), ".") <= 0 then IsValidEmail = false exit function end if i = Len(names(1)) - InStrRev(names(1), ".") if i <> 2 and i <> 3 and i <> 4 and i <> 5 and i <> 6 then IsValidEmail = false exit function end if if InStr(email, "..") > 0 then IsValidEmail = false end if end function '以下这个函数及本文件所有函数勿删 function get_logined_username() sussd="" if session("nd_cache_logined_user")<>"" then sussd=session("nd_cache_logined_user") else if request.Cookies("nd_cc_cache_logined_user")<>"" then sussd=request.Cookies("nd_cc_cache_logined_user") end if end if get_logined_username=sussd end function Function n_RemoveHTML_md(strHTML) n_RemoveHTML_md="" on error resume next strHTML=cstr(strHTML&"") Set objRegExp = New Regexp objRegExp.IgnoreCase = True objRegExp.Global = True '取闭合的<> objRegExp.Pattern = "<.+?>" '进行匹配 Set Matches = objRegExp.Execute(strHTML) ' 遍历匹配集合,并替换掉匹配的项目 For Each Match in Matches strHtml=Replace(strHTML,Match.Value,"") Next n_RemoveHTML_md=strHTML Set objRegExp = Nothing End Function '以下这个函数及本文件所有函数勿删 Function get_v_logined_username() if session("nd_cache_logined_user")="" then if request.cookies("nd_cc_cache_logined_user")="" then uuuaa2="" else uuuaa2=request.cookies("nd_cc_cache_logined_user") end if else uuuaa2=session("nd_cache_logined_user") end if get_v_logined_username=uuuaa2 End Function Function get_value_by_id_inbiao(biaonm,id,ziduan) on error resume next err.clear set rs11xgg=server.CreateObject("adodb.recordset") rs11xgg.open "select * from "&biaonm&" where id="&id,newdsoft_conn_obj,1,1 if err.number<>0 then err.clear get_value_by_id_inbiao="名称字段不存在" else if not rs11xgg.eof then get_value_by_id_inbiao=rs11xgg(ziduan) else get_value_by_id_inbiao="此记录不存在" end if end if End Function '以下这个函数及本文件所有函数勿删 function paixu_a(arr,lenarr,cixu_index,lenmaxsb) '次序号字段的索引位置: 'cixu_index redim can(lenarr+1,11) redim can_temp(lenarr+1,11) '排序算法: redim minvalue_index(lenarr+1) lenttt=lenarr for isssaa=0 to lenttt minvalue_index(isssaa)=-123 next '----------paixu code--------------- for nowmin=0 to lenttt firstrun=1 for mppp=0 to lenttt '----------排除排过了的元素 need_break=0 for nowmintest=0 to nowmin if minvalue_index(nowmintest)=mppp then need_break=1 exit for end if next '--------end 排除排过了的元素 if need_break=0 then if firstrun=1 then firstrun=0 minvalue_index(nowmin)=mppp end if end if if need_break=0 then if clng(arr(mppp,cixu_index))<clng(arr(minvalue_index(nowmin),cixu_index)) then minvalue_index(nowmin)=mppp end if end if next next '----------end paixu code------- for nowii=0 to lenttt for iiiaa=0 to lenmaxsb can_temp(nowii,iiiaa)=arr(minvalue_index(nowii),iiiaa) next next for nowii2=0 to lenttt for iiiaa2=0 to lenmaxsb arr(nowii2,iiiaa2)=can_temp(nowii2,iiiaa2) next next paixu_a=arr end function function get_checkbox_value_format(aia) if cstr(aia&"")="1" then get_checkbox_value_format="1" else get_checkbox_value_format="0" end if end function function get_str_value_format(aia) if cstr(aia&"")<>"" then get_str_value_format=""""&aia&"""" else get_str_value_format="""""" end if end function function get_str_value_format_b(aia) if cstr(aia&"")<>"" then get_str_value_format_b=aia else get_str_value_format_b="""""" end if end function function get_is_checked_xm(stra,myid) get_is_checked_xm="0" if stra<>"" then stra_p=split(stra,"|") for sii=0 to ubound(stra_p) stra_p_1=stra_p(sii) stra_p_1_p=split(stra_p_1,",") if cstr(stra_p_1_p(0))=cstr(myid) then get_is_checked_xm=cstr(stra_p_1_p(1)) exit for end if next end if end function function get_self_f_name() '获取自身文件名 aryxx1 =split(Request.ServerVariables("SCRIPT_NAME"),"/") get_self_f_name = aryxx1(ubound(aryxx1)) end function function replace_textare_for_md(LabelContent) if LabelContent="" then replace_textare_for_md="" exit function end if LabelContent=cstr(LabelContent&"") Set regEx = New RegExp regEx.IgnoreCase = True regEx.Global = True '解决文本框重复问题 regEx.Pattern = "(\<textarea\>)" LabelContent = regEx.Replace(LabelContent, "[$textarea]") regEx.Pattern = "(\<\/textarea\>)" LabelContent = regEx.Replace(LabelContent, "[$/textarea]") LabelContent=replace(LabelContent,"<",chr(60)) LabelContent=replace(LabelContent,">",chr(62)) replace_textare_for_md=LabelContent end function function huanyuan_textare_for_md(LabelContent) if LabelContent="" then huanyuan_textare_for_md="" exit function end if LabelContent=cstr(LabelContent&"") Set regEx = New RegExp regEx.IgnoreCase = True regEx.Global = True '解决文本框重复问题 regEx.Pattern = "(\[\$textarea\])" LabelContent = regEx.Replace(LabelContent, "<textarea>") regEx.Pattern = "(\[\$\/textarea\])" LabelContent = regEx.Replace(LabelContent, "</textarea>") huanyuan_textare_for_md=LabelContent end function Class Cls_FSO Public objFSO Private Sub Class_Initialize() Set objFSO = Server.CreateObject("$$fssoo_nd_var_str_x_customx$x$") End Sub Private Sub class_terminate() Set objFSO = Nothing End Sub '=======文件操作======== '取文件大小 Public Function GetFileSize(FileName) Dim f If ReportFileStatus(FileName) = 1 Then Set f = objFSO.Getfile(FileName) GetFileSize = f.Size Else GetFileSize = -1 End if End Function '文件删除 Public Function deleteAFile(FileSpec) If ReportFileStatus(FileSpec) = 1 Then objFSO.deleteFile(FileSpec) deleteAFile = 1 Else deleteAFile = -1 End if End Function '显示文件列表 Public Function ShowFileList(FolderSpec) Dim f, f1, fc, s If ReportFolderStatus(FolderSpec) = 1 Then Set f = objFSO.GetFolder(FolderSpec) Set fc = f.Files For Each f1 in fc s = s & f1.name s = s & "|" Next ShowFileList = s Else ShowFileList = -1 End if End Function '文件复制 Public Function CopyAFile(SourceFile, DestinationFile) Dim MyFile If ReportFileStatus(SourceFile) = 1 Then Set MyFile = objFSO.GetFile(SourceFile) MyFile.Copy (DestinationFile) CopyAFile = 1 Else CopyAFile = -1 End if End Function '文件移动 Public Function MoveAFile(SourceFile,DestinationFile) If ReportFileStatus(SourceFile) = 1 And ReportFileStatus(DestinationFileORPath) = -1 Then objFSO.MoveFile SourceFile,DestinationFileORPath MoveAFile = 1 Else MoveAFile = -1 End if End Function '文件是否存在? Public Function ReportFileStatus(FileName) Dim msg msg = -1 If (objFSO.FileExists(FileName)) Then msg = 1 Else msg = -1 End If ReportFileStatus = msg End Function '文件创建日期 Public Function ShowDatecreated(FileSpec) Dim f If ReportFileStatus(FileSpec) = 1 Then Set f = objFSO.GetFile(FileSpec) ShowDatecreated = f.Datecreated Else ShowDatecreated = -1 End if End Function '文件属性 Public Function GetAttributes(FileName) Dim f Dim strFileAttributes If ReportFileStatus(FileName) = 1 Then Set f = objFSO.GetFile(FileName) select Case f.attributes Case 0 strFileAttributes = "普通文件。没有设置任何属性。 " Case 1 strFileAttributes = "只读文件。可读写。 " Case 2 strFileAttributes = "隐藏文件。可读写。 " Case 4 strFileAttributes = "系统文件。可读写。 " Case 16 strFileAttributes = "文件夹或目录。只读。 " Case 32 strFileAttributes = "上次备份后已更改的文件。可读写。 " Case 1024 strFileAttributes = "链接或快捷方式。只读。 " Case 2048 strFileAttributes = " 压缩文件。只读。" End select GetAttributes = strFileAttributes Else GetAttributes = -1 End if End Function '最后一次访问/最后一次修改时间 Public Function ShowFileAccessInfo(FileName,InfoType) '//功能:显示文件创建时信息 '//形参:文件名,信息类别 '// 1 -----创建时间 '// 2 -----上次访问时间 '// 3 -----上次修改时间 '// 4 -----文件路径 '// 5 -----文件名称 '// 6 -----文件类型 '// 7 -----文件大小 '// 8 -----父目录 '// 9 -----根目录 Dim f, s If ReportFileStatus(FileName) = 1 then Set f = objFSO.GetFile(FileName) select Case InfoType Case 1 s = f.Datecreated Case 2 s = f.DateLastAccessed Case 3 s = f.DateLastModified Case 4 s = f.Path Case 5 s = f.Name Case 6 s = f.Type Case 7 s = f.Size Case 8 s = f.ParentFolder Case 9 s = f.RootFolder End select ShowFileAccessInfo = s ELse ShowFileAccessInfo = -1 End if End Function '写文本文件 Public Function WriteTxtFile(FileName,TextStr,WriteORAppendType) Const ForReading = 1, ForWriting = 2 , ForAppending = 8 Dim f, m select Case WriteORAppendType Case 1: '文件进行写操作 Set f = objFSO.OpenTextFile(FileName, ForWriting, True) f.Write TextStr f.Close If ReportFileStatus(FileName) = 1 then WriteTxtFile = 1 Else WriteTxtFile = -1 End if Case 2: '文件末尾进行写操作 If ReportFileStatus(FileName) = 1 then Set f = objFSO.OpenTextFile(FileName, ForAppending) f.Write TextStr f.Close WriteTxtFile = 1 Else WriteTxtFile = -1 End if End select End Function '读文本文件 Public Function ReadTxtFile(FileName) Const ForReading = 1, ForWriting = 2 Dim f, m If ReportFileStatus(FileName) = 1 then Set f = objFSO.OpenTextFile(FileName, ForReading) m = f.ReadLine ReadTxtFile = m f.Close Else ReadTxtFile = -1 End if End Function '建立文本文件 '=======目录操作======== '取目录大小 Public Function GetFolderSize(FolderName) Dim f If ReportFolderStatus(FolderName) = 1 Then Set f = objFSO.GetFolder(FolderName) GetFolderSize = f.Size Else GetFolderSize = -1 End if End Function '创建的文件夹 Public Function createFolderDemo(FolderName) Dim f If ReportFolderStatus(Folderspec) = 1 Then createFolderDemo = -1 Else Set f = objFSO.createFolder(FolderName) createFolderDemo = 1 End if End Function '目录删除 Public Function deleteAFolder(Folderspec) If ReportFolderStatus(Folderspec) = 1 Then objFSO.deleteFolder (Folderspec) deleteAFolder = 1 Else deleteAFolder = -1 End if End Function '显示目录列表 Public Function ShowFolderList(FolderSpec) Dim f, f1, fc, s If ReportFolderStatus(FolderSpec) = 1 Then Set f = objFSO.GetFolder(FolderSpec) Set fc = f.SubFolders For Each f1 in fc s = s & f1.name s = s & "|" Next ShowFolderList = s Else ShowFolderList = -1 End if End Function '目录复制 Public Function CopyAFolder(SourceFolder,DestinationFolder) objFSO.CopyFolder SourceFolder,DestinationFolder CopyAFolder = 1 CopyAFolder = -1 End Function '目录进行移动 Public Function MoveAFolder(SourcePath,DestinationPath) If ReportFolderStatus(SourcePath)=1 And ReportFolderStatus(DestinationPath)=0 Then objFSO.MoveFolder SourcePath, DestinationPath MoveAFolder = 1 Else MoveAFolder = -1 End if End Function '判断目录是否存在 Public Function ReportFolderStatus(fldr) Dim msg msg = -1 If (objFSO.FolderExists(fldr)) Then msg = 1 Else msg = -1 End If ReportFolderStatus = msg End Function '目录创建时信息 Public Function ShowFolderAccessInfo(FolderName,InfoType) '//功能:显示目录创建时信息 '//形参:目录名,信息类别 '// 1 -----创建时间 '// 2 -----上次访问时间 '// 3 -----上次修改时间 '// 4 -----目录路径 '// 5 -----目录名称 '// 6 -----目录类型 '// 7 -----目录大小 '// 8 -----父目录 '// 9 -----根目录 Dim f, s If ReportFolderStatus(FolderName) = 1 then Set f = objFSO.GetFolder(FolderName) select Case InfoType Case 1 s = f.Datecreated Case 2 s = f.DateLastAccessed Case 3 s = f.DateLastModified Case 4 s = f.Path Case 5 s = f.Name Case 6 s = f.Type Case 7 s = f.Size Case 8 s = f.ParentFolder Case 9 s = f.RootFolder End select ShowFolderAccessInfo = s ELse ShowFolderAccessInfo = -1 End if End Function '遍历目录 Public Function DisplayLevelDepth(pathspec) Dim f, n ,Path Set f = objFSO.GetFolder(pathspec) If f.IsRootFolder Then DisplayLevelDepth ="指定的文件夹是根文件夹。"&RootFolder Else Do Until f.IsRootFolder Path = Path & f.Name &"<br>" Set f = f.ParentFolder n = n + 1 Loop DisplayLevelDepth ="指定的文件夹是嵌套级为 " & n & " 的文件夹。<br>" & Path End If End Function '========磁盘操作======== '驱动器是否存在? Public Function ReportDriveStatus(drv) Dim msg msg = -1 If objFSO.DriveExists(drv) Then msg = 1 Else msg = -1 End If ReportDriveStatus = msg End Function '可用的返回类型包括 FAT、NTFS 和 CDFS。 Public Function ShowFileSystemType(drvspec) Dim d If ReportDriveStatus(drvspec) = 1 Then Set d = objFSO.GetDrive(drvspec) ShowFileSystemType = d.FileSystem ELse ShowFileSystemType = -1 End if End Function End Class nodooooooa=0 if have_a1="" then have_a1="1" '*********************************************** '函数名:JoinChar '作 用:向地址中加入 ? 或 & '参 数:strUrl ----网址 '返回值:加了 ? 或 & 的网址 '*********************************************** function JoinChar(strUrl) if strUrl="" then JoinChar="" exit function end if if InStr(strUrl,"?")<len(strUrl) then if InStr(strUrl,"?")>1 then if InStr(strUrl,"&")<len(strUrl) then JoinChar=strUrl & "&" else JoinChar=strUrl end if else JoinChar=strUrl & "?" end if else JoinChar=strUrl end if end function 'Dim Fy_Url,Fy_a,Fy_x,Fy_Cs(),Fy_Cl,Fy_Ts,Fy_Zx '---定义部份 头------ Fy_Cl = 2 '处理方式:1=提示信息,2=转向页面,3=先提示再转向 Fy_Zx = "/Error.Asp" '出错时转向的页面 '---定义部份 尾------ 'ruandingyuan xiugai Fy_Url=Request.ServerVariables("QUERY_STRING") Fy_a=split(Fy_Url,"&") redim Fy_Cs(ubound(Fy_a)) for Fy_x=0 to ubound(Fy_a) Fy_Cs(Fy_x) = left(Fy_a(Fy_x),instr(Fy_a(Fy_x),"=")-1) Next For Fy_x=0 to ubound(Fy_Cs) If Fy_Cs(Fy_x)<>"" Then If Instr(LCase(Request(Fy_Cs(Fy_x))),"'")<>0 or Instr(LCase(Request(Fy_Cs(Fy_x))),"and ")<>0 or Instr(LCase(Request(Fy_Cs(Fy_x))),"and%20")<>0 or Instr(LCase(Request(Fy_Cs(Fy_x))),"select")<>0 or (Instr(LCase(Request(Fy_Cs(Fy_x))),"update")<>0 and Instr(LCase(Request(Fy_Cs(Fy_x))),"set")<>0) or Instr(LCase(Request(Fy_Cs(Fy_x))),"chr")<>0 or Instr(LCase(Request(Fy_Cs(Fy_x))),"delete%20from")<>0 or (Instr(LCase(Request(Fy_Cs(Fy_x))),"delete")<>0 and Instr(LCase(Request(Fy_Cs(Fy_x))),"from")<>0) or Instr(LCase(Request(Fy_Cs(Fy_x))),";")<>0 or (Instr(LCase(Request(Fy_Cs(Fy_x))),"insert")<>0 and Instr(LCase(Request(Fy_Cs(Fy_x))),"into")<>0) or Instr(LCase(Request(Fy_Cs(Fy_x))),"mid")<>0 Or Instr(LCase(Request(Fy_Cs(Fy_x))),"master.")<>0 Then Select Case Fy_Cl Case "1" Response.Write "<Script Language=JavaScript>alert('出现错误!参数 "&Fy_Cs(Fy_x)&" 的值中包含非法字符串!\n\n 请不要在参数中出现:;,and%20,select%20,update%20,insert%20,delete,chr 等非法字符!);window.close();</Script>" Case "2" Response.Write "<Script Language=JavaScript>location.href='"&Fy_Zx&"'</Script>" Case "3" Response.Write "<Script Language=JavaScript>alert('出现错误!参数 "&Fy_Cs(Fy_x)&"的值中包含非法字符串!\n\n 请不要在参数中出现:;,and%20,select%20,update%20,insert%20,delete%20,chr 等非法字符!);location.href='"&Fy_Zx&"';</Script>" End Select nodooooooa=1 Response.End End If End If Next 'post方式的sql注入,则直接禁止站点外部提交post if lcase(Request.Servervariables("REQUEST_METHOD"))="post" then server_v1=Cstr(Request.ServerVariables("HTTP_REFERER")) server_v2=Cstr(Request.ServerVariables("SERVER_NAME")) if mid(server_v1,8,len(server_v2))<>server_v2 then nodooooooa=1 response.write "<br><br><center><table border=1 cellpadding=20 bordercolor=black bgcolor=#EEEEEE width=450>" response.write "<tr><td style='font:9pt Verdana'>" response.write "你提交的路径有误,禁止从站点外部提交数据,请不要乱该参数!" response.write "</td></tr></table></center>" response.end end if end if nd_web_output_folder_b="xndasp" nd_web_output_folder_qiye_b="xcomasp" 'Dim ConnStr if nodooooooa=0 then ConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(dir_set&"$$xxxx_d_soft_complie$$db_str$") Set $$xxxx_d_soft_complie$$conn$ = Server.CreateObject("ADODB.Connection") $$xxxx_d_soft_complie$$conn$.open ConnStr If Err Then Err.Clear Set $$xxxx_d_soft_complie$$conn$ = Nothing Response.Write "数据库连接出错,请检查Conn.asp文件中的数据库参数设置。" Response.End End If end if if request("ruandingyuan_do")="getinfox" then response.write "本站使用新"&""&"动"&"软系统制作,"&"系"&"统"&"作"&"者:"&"阮"&""&"丁"&"远,官网:ww"&"w.as"&"pcpu.com" response.end end if J_True = "True" J_False = "False" J_Now = "Now()" '获得现在的时间 end if '放在这,以免标签循环嵌套导致本函数循环定义而导致asp错误 '放在这,以免标签循环嵌套导致本函数循环定义而导致asp错误 if is_haved_g_fontaa="" then is_haved_g_fontaa="1" Function getFontMode(str, vColor, vFont,vSize) Dim FontStr, tColor Dim ColorStr, arrColor If IsNull(str) Then getFontMode = "" Exit Function End If getFontMode = str FontStr=str Select Case CInt(vFont) Case 1 FontStr = "<b>" & str & "</b>" Case 2 FontStr = "<em>" & str & "</em>" Case 3 FontStr = "<u>" & str & "</u>" Case 4 FontStr = "<b><em>" & str & "</em></b>" Case 5 FontStr = "<b><u>" & str & "</u></b>" Case 6 FontStr = "<em><u>" & str & "</u></em>" Case 7 FontStr = "<b><em><u>" & str & "</u></em></b>" Case Else FontStr = str End Select getFontMode = FontStr If vColor = "" Then Exit Function 'ColorStr = "," & InitTitleColor 'arrColor = Split(ColorStr, ",") 'If vColor > UBound(arrColor) Then Exit Function 'tColor = Trim(arrColor(vColor)) if vColor ="0" then 'ssscolor="<font style='font-size:"&vSize&" px;'>" 'ssscolor2="</font>" else 'ssscolor="<font color="&vColor&" style='font-size:"&vSize&" px;'>" 'ssscolor2="</font>" ssscolor="<span style='color:"&vColor&";'>" ssscolor2="</span>" end if getFontMode = ssscolor& FontStr & ssscolor2 End Function end if '放在这,以免标签循环嵌套导致本函数循环定义而导致asp错误 if haved_atype_a="" then haved_atype_a="1" function get_art_type(in1) get_art_type="" if in1="1" then get_art_type="<font color=red>[图文]</font>" if in1="2" then get_art_type="<font color=red>[组图]</font>" if in1="3" then get_art_type="<font color=red>[新闻]</font>" if in1="4" then get_art_type="<font color=red>[推荐]</font>" if in1="5" then get_art_type="<font color=red>[注意]</font>" if in1="6" then get_art_type="<font color=red>[转载]</font>" if in1="7" then get_art_type="<font color=red>[最新]</font>" end function end if '放在这,以免标签循环嵌套导致本函数循环定义而导致asp错误 function findx_price(grade_id,str) rst2="" if str<>"" then other_params=split(str,"|") for i=0 to ubound(other_params) sss11=split(other_params(i),":") sss11a=sss11(0) sss11b=sss11(1) if cstr(sss11a)=cstr(grade_id) then rst2=sss11b exit for end if next end if if isnumeric(rst2)<>true then rst2="" end if findx_price=rst2 end function %>